home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / mquery / mquery.bas < prev    next >
BASIC Source File  |  1995-05-09  |  28KB  |  938 lines
  1. '------------------------------------------------------------
  2. ' VISDATA.BAS
  3. ' support functions for the Visual Data sample application
  4. '
  5. ' General Information: This app is intended to demonstrate
  6. '   and exercise all of the functionality available in the
  7. '   VT (Virtual Table) Object layer in VB 3.0 Pro.
  8. '
  9. '   Any valid SQL statement may be sent via the Utility SQL
  10. '   function excluding "select" statements which may be
  11. '   executed from the Dynaset Create function. With these
  12. '   two features, this simple app becomes a powerful data
  13. '   definition and query tool accessing any ODBC driver
  14. '   available at the time.
  15. '
  16. '   The app has the capability to perform all DDL (data
  17. '   definition language) functions. These are accessed
  18. '   from the "Tables" form. This form accesses the
  19. '   "NewTable", "AddField" and "IndexAdd" forms to do
  20. '   the actual table, field and index definition.
  21. '   Tables and Indexes may be deleted when the corresponding
  22. '   "Delete" button is enabled. It is not possible to
  23. '   delete fields.
  24. '
  25. ' Naming Conventions:
  26. '   "f..."   = Form
  27. '   "c..."   = Form control
  28. '   "F..."   = Form level variable
  29. '   "gst..." = Global String
  30. '   "gf..."  = Global flag (true/false)
  31. '   "gw..."  = Global 2 byte integer value
  32. '
  33. '------------------------------------------------------------
  34.  
  35. Option Explicit
  36.  
  37. 'api declarations
  38. Declare Function GetPrivateProfileString Lib "Kernel" (ByVal lpApplicationName As String, ByVal lpKeyname As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Integer, ByVal lpFileName As String) As Integer
  39. Declare Function WritePrivateProfileString Lib "Kernel" (ByVal lpApplicationName As String, ByVal lpKeyname As String, ByVal lpstring As String, ByVal lplFileName As String) As Integer
  40. Declare Function GetWindowsDirectory Lib "Kernel" (ByVal lpBuffer As String, ByVal nSize As Integer) As Integer
  41.  
  42. 'global object variables
  43. Global gCurrentDB As Database
  44. Global gfDBOpenFlag As Integer
  45. Global gCurrentDS As Dynaset
  46. Global gCurrentTbl As Table
  47. Global gCurrentQueryDef As QueryDef
  48. Global gCurrentField As Field
  49. Global gCurrentIndex As Index
  50. Global gTableListSS As Snapshot
  51.  
  52. 'global database variables
  53. Global gstDataType As String
  54. Global gstDBName As String
  55. Global gstUserName As String
  56. Global gstPassword As String
  57. Global gstDataBase As String
  58. Global gstDynaString As String
  59. Global gstTblName As String
  60. Global gfUpdatable As Integer
  61. Global glQueryTimeout As Long
  62. Global glLoginTimeout As Long
  63. Global gstTableDynaFilter As String
  64. Global gTblname As String ' used for filter and sort in grid and dynaset
  65. 'other global vars
  66. Global gstZoomData As String
  67. Global gwMaxGridRows As Long
  68. Global gWindowsDirectory As String
  69. Global gSQLUser As String
  70.  
  71. 'new field properties
  72. Global gwFldType As Integer
  73. Global gwFldSize As Integer
  74. Global gsumcolwid As Integer
  75. 'global find values
  76. Global gfFindFailed As Integer
  77. Global gstFindExpr As String
  78. Global gstFindOp As String
  79. Global gstFindField As String
  80. Global gfFindMatch As Integer
  81. Global gfFromTableView As Integer
  82.  
  83.  ' global filter values
  84. Global gFilterStr As String
  85.  
  86.  ' global sort values
  87. Global gSortStr As String
  88.  
  89.   ' Global flag for stored queries
  90. Global gStoredFlag As Integer
  91.  
  92. 'global seek values
  93. Global gstSeekOperator As String
  94. Global gstSeekValue As String
  95.  
  96. 'global flags
  97. Global gfDBChanged As Integer
  98. Global gfFROMSQL As Integer
  99. Global gfTransPending As Integer
  100. Global gfAddTableFlag As Integer
  101.  
  102. 'global constants
  103. Global Const DEFAULTDRIVER = "SQL Server"
  104. Global Const MODAL = 1
  105. Global Const HOURGLASS = 11
  106. Global Const DEFAULT_MOUSE = 0
  107. Global Const YES = 6
  108. Global Const MSGBOX_TYPE = 4 + 48 + 256
  109. Global Const TRUE_ST = "True"
  110. Global Const FALSE_ST = "False"
  111. Global Const EOF_ERR = 626
  112. Global Const FTBLS = 0
  113. Global Const FFLDS = 1
  114. Global Const FINDX = 2
  115. Global Const MAX_GRID_ROWS = 31999
  116. Global Const MAX_MEMO_SIZE = 20000
  117. Global Const GETCHUNK_CUTOFF = 50
  118. Global Const MB_YESNOCANCEL = 3
  119. Global Const MB_YESNO = 4
  120. Global Const MB_ICONSTOP = 16
  121. Global Const MB_ICONQUESTION = 32
  122. Global Const MB_ICONEXCLAMATION = 48
  123. Global Const MB_ICONINFORMATION = 64
  124. Global Const MB_DEFBUTTON2 = 256
  125. Global Const IDYES = 6
  126. Global Const IDNO = 7
  127. ' Define other.
  128.  
  129.  
  130.  
  131.  
  132. 'field type constants
  133. Global Const FT_TRUEFALSE = 1
  134. Global Const FT_BYTE = 2
  135. Global Const FT_INTEGER = 3
  136. Global Const FT_LONG = 4
  137. Global Const FT_CURRENCY = 5
  138. Global Const FT_SINGLE = 6
  139. Global Const FT_DOUBLE = 7
  140. Global Const FT_DATETIME = 8
  141. Global Const FT_STRING = 10
  142. Global Const FT_BINARY = 11
  143. Global Const FT_MEMO = 12
  144.  
  145. 'table type constants
  146. Global Const DB_TABLE = 1
  147. Global Const DB_ATTACHEDTABLE = 6
  148. Global Const DB_ATTACHEDODBC = 4
  149. Global Const DB_QUERYDEF = 5
  150. Global Const DB_SYSTEMOBJECT = &H80000002
  151.  
  152. 'dynaset option parameter constants
  153. Global Const VBDA_DENYWRITE = &H1
  154. Global Const VBDA_DENYREAD = &H2
  155. Global Const VBDA_READONLY = &H4
  156. Global Const VBDA_APPENDONLY = &H8
  157. Global Const VBDA_INCONSISTENT = &H10
  158. Global Const VBDA_CONSISTENT = &H20
  159. Global Const VBDA_SQLPASSTHROUGH = &H40
  160.  
  161. 'db create/compact constants
  162. Global Const DB_CREATE_GENERAL = ";langid=0x0809;cp=1252;country=0"
  163. Global Const DB_VERSION10 = 1
  164.  
  165. ' Microsoft Access QueryDef types
  166. Global Const DB_QACTION = &HF0
  167. Global Const DB_QCROSSTAB = &H10
  168. Global Const DB_QDELETE = &H20
  169. Global Const DB_QUPDATE = &H30
  170. Global Const DB_QAPPEND = &H40
  171. Global Const DB_QMAKETABLE = &H50
  172.  
  173. ' Index Attributes
  174. Global Const DB_UNIQUE = 1
  175. Global Const DB_PRIMARY = 2
  176. Global Const DB_PROHIBITNULL = 4
  177. Global Const DB_IGNORENULL = 8
  178. Global Const DB_DESCENDING = 1  'For each field in Index
  179.  
  180. Function ActionQueryType (qn As String) As String
  181.   Dim i As Integer
  182.  
  183.   gTableListSS.MoveFirst
  184.   While gTableListSS.EOF = False And gTableListSS!Name <> qn
  185.     gTableListSS.MoveNext
  186.   Wend
  187.   If gTableListSS!Name = qn Then
  188.     Select Case gTableListSS!Attributes
  189.       Case DB_QCROSSTAB
  190.         ActionQueryType = "Cross Tab"
  191.       Case DB_QDELETE
  192.         ActionQueryType = "Delete"
  193.       Case DB_QUPDATE
  194.         ActionQueryType = "Update"
  195.       Case DB_QAPPEND
  196.         ActionQueryType = "Append"
  197.       Case DB_QMAKETABLE
  198.         ActionQueryType = "Make Table"
  199.     End Select
  200.   Else
  201.     ActionQueryType = ""
  202.   End If
  203.  
  204. End Function
  205.  
  206. Sub ExecSql ()
  207.    Dim RetSQL As Long
  208.    If Not gStoredFlag Then ' flag goes here
  209.    If fQuery!cCriteria = "" Then ' no sql statment
  210.    gfFROMSQL = False
  211.    Exit Sub
  212.    End If
  213.    Else
  214.        gfFROMSQL = False
  215.         ResetMouse fQuery
  216.         MsgBar "", False
  217.         'gStoredFlag = False
  218.         If fQuery!Option1(0) = False Then
  219.          Dim dsform1 As New fDynaset
  220.          dsform1.Show
  221.         Else
  222.          Dim dsform2 As New fGridFrm
  223.          dsform2.Show
  224.        End If
  225.  
  226.    Exit Sub
  227.    End If
  228.    MsgBar "Executing SQL Statement", True
  229.    'SetHourGlass Me
  230.    If UCase(Mid(fQuery!cCriteria, 1, 6)) = "SELECT" And InStr(UCase(fQuery!cCriteria), " INTO ") = 0 Then
  231.      On Error GoTo SQLDSErr
  232. MakeDynaset:
  233.      gfFROMSQL = True
  234.      'create a new dynaset form
  235.      gstDynaString = ""
  236.     On Error GoTo SQLDSErr
  237.        If fQuery!Option1(0) = False Then
  238.          Dim dsform3 As New fDynaset
  239.          dsform3.Show
  240.        Else
  241.          Dim dsform4 As New fGridFrm
  242.          dsform4.Show
  243.        End If
  244.      On Error GoTo SQLErr
  245.  
  246.    End If
  247.  
  248.    GoTo SQLEnd
  249.  
  250. SQLErr:
  251.    If Err = 3065 Then   'row returning so try to create dynaset
  252.      Resume MakeDynaset
  253.    End If
  254.    ShowError
  255.    Resume SQLEnd
  256.  
  257. SQLDSErr:
  258.    Resume SQLEnd
  259.  
  260. SQLEnd:
  261.    ResetMouse fQuery
  262.    MsgBar "", False
  263.  
  264. End Sub
  265.  
  266. Function GetFieldType (ft As String) As Integer
  267.   'return field length
  268.   If ft = "String" Then
  269.     GetFieldType = FT_STRING
  270.   Else
  271.     Select Case ft
  272.       Case "Counter"
  273.         GetFieldType = FT_LONG
  274.       Case "True/False"
  275.         GetFieldType = FT_TRUEFALSE
  276.       Case "Byte"
  277.         GetFieldType = FT_BYTE
  278.       Case "Integer"
  279.         GetFieldType = FT_INTEGER
  280.       Case "Long"
  281.         GetFieldType = FT_LONG
  282.       Case "Currency"
  283.         GetFieldType = FT_CURRENCY
  284.